home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / tools / cie.lha / cie / hier-mode.el < prev    next >
Lisp/Scheme  |  1993-06-21  |  11KB  |  354 lines
  1. ;;; hier-mode.el
  2. ;;; Hierarchy mode (for hierarchies output by hier++)
  3.  
  4. ;;; See the docstring for defun hier-mode for a description.
  5.  
  6. ;;; Copyright (C) 1993, Intellection Inc.
  7. ;;;
  8. ;;; Author: Brian M Kennedy (kennedy@intellection.com)
  9. ;;;
  10. ;;; This program is free software; you can redistribute it and/or modify
  11. ;;; it under the terms of the GNU General Public License as published by
  12. ;;; the Free Software Foundation; either version 1, or (at your option)
  13. ;;; any later version.
  14. ;;;
  15. ;;; This program is distributed in the hope that it will be useful,
  16. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;;; GNU General Public License for more details.
  19. ;;;
  20. ;;; A copy of the GNU General Public License can be obtained from the
  21. ;;; Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22.  
  23. ;;; 92/08     Brian M Kennedy  Added direct access commands; added sort to member list
  24. ;;; 92/06     Brian M Kennedy  Original 
  25. ;;; (using other GNU Emacs modes as a template)
  26.  
  27. ;;; Ideally, this mode should be rewritten based on outline.el, by simply setting
  28. ;;; a few of outline.el's variables.  That would provide additional functionality
  29. ;;; such as hide/show.  But to do it right, you should modify the other functions
  30. ;;; in this file to auto-show things being searched for (otherwise, hiding would
  31. ;;; be more a hindrance than a help).
  32.  
  33. (provide 'hier-mode)
  34.  
  35. (autoload 'visit-tags-table-buffer "tags")
  36. (autoload 'prompt-for-tag          "tags")
  37.  
  38.  
  39. (defvar hier-mode-syntax-table nil
  40.   "Syntax table used while in hier mode.")
  41. (if hier-mode-syntax-table
  42.     ()
  43.   (setq hier-mode-syntax-table (make-syntax-table))
  44.   )
  45.  
  46. (defvar hier-mode-abbrev-table nil
  47.   "Abbrev table used while in bib mode.")
  48. (define-abbrev-table 'hier-mode-abbrev-table ())
  49.  
  50. (defvar hier-mode-map nil "")
  51. (if hier-mode-map
  52.     ()
  53.   (setq hier-mode-map (make-sparse-keymap))
  54.   (define-key hier-mode-map "\M-h" 'hier-find)
  55.   (define-key hier-mode-map "\M-g" 'hier-find-again)
  56.   (define-key hier-mode-map "\M-m" 'hier-show-members)
  57.   (define-key hier-mode-map "\M-p" 'hier-previous-element)
  58.   (define-key hier-mode-map "\M-n" 'hier-next-element)
  59.   (define-key hier-mode-map "\M-u" 'hier-upto-parent)
  60.   )
  61.  
  62. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  63.  
  64. (defun hier-mode ()
  65.   "Major mode for viewing class hierarchy files output by hier++.
  66. The file is formatted like this:
  67.  
  68. * class_a 
  69.   * child_b  :class_a
  70.   * child_c  :class_a :class_f
  71.     * grandchild_d  :child_c
  72.     * grandchild_e  :child_c
  73. * class_f
  74.   * child_c  :class_a :class_f
  75.     * grandchild_d  :child_c
  76.     * grandchild_e  :child_c
  77.   * child_g  :class_f
  78.  
  79. Classes child_b and child_c are derived from class_a; classes child_c and
  80. child_g are derived from class_f; classes grandchild_d and grandchild_e are
  81. both derived from child_c.  Note that each class (and all of its children) 
  82. will appear in the file once under each parent.
  83.  
  84. Defined keys:
  85. M-p moves to the previous sibling
  86. M-n moves to the next sibling
  87. M-u moves up to the parent
  88. M-h finds the first occurrence of the hierarchy element for a class 
  89.     (similar to M-. in behavior)
  90. M-g finds the next occurrence (like M-,) in the case of multiple-inheritance.
  91. M-m brings up a new window with a listing of all the members (both direct and 
  92.     inherited) of that hierarchy entry.  It does this via tags, so you must 
  93.     have tags set up in Emacs.  It will also only work properly if the tags 
  94.     file was generated by etags++ (companion to hier++)."
  95.   (interactive)
  96.   (kill-all-local-variables)
  97.   (use-local-map hier-mode-map)
  98.   (setq mode-name "Hierarchy")
  99.   (setq major-mode 'hier-mode)
  100.   (setq local-abbrev-table hier-mode-abbrev-table)
  101.   (set-syntax-table hier-mode-syntax-table)
  102.   ;(run-hooks 'hier-mode-hook)
  103.   )
  104.  
  105. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  106. ;; Find hierarchy elements
  107.  
  108. ;; Return a default name to search for, based on the text at point.
  109. (defun hier-find-default ()
  110.   (save-excursion
  111.     (while (looking-at "\\sw\\|\\s_")
  112.       (forward-char 1))
  113.     (if (re-search-backward "\\sw\\|\\s_" nil t)
  114.     (progn (forward-char 1)
  115.            (buffer-substring (point)
  116.                  (progn (forward-sexp -1)
  117.                     (while (looking-at "\\s'")
  118.                       (forward-char 1))
  119.                     (point))))
  120.       nil)))
  121.  
  122. (defun hier-find-element (string)
  123.   (let* ((default (hier-find-default))
  124.      (spec (read-string
  125.         (if default
  126.             (format "%s(default %s) " string default)
  127.           string))))
  128.     (list (if (equal spec "")
  129.           default
  130.         spec))))
  131.  
  132. (defvar hier-last-find-element nil
  133.   "The last element searched for by hier-find.")
  134.  
  135. (defun hier-find (element)
  136.   (interactive (hier-find-element "Find element: "))
  137.   (setq hier-last-find-element (concat "* " element " "))
  138.   (goto-char (point-min))
  139.   (hier-find-again)
  140.   )
  141.  
  142. (defun hier-find-again ()
  143.   (interactive)
  144.   (if hier-last-find-element
  145.       (search-forward hier-last-find-element)))
  146.  
  147. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  148. ;; Cursor movement through hierarchy
  149.  
  150. (defun hier-previous-element (ignore)
  151.   "Goto previous hierarchy element at this level or higher."
  152.   (interactive "p")
  153.   (back-to-indentation)
  154.   (let ((indent (current-indentation)))
  155.     (previous-line 1)
  156.     (while (< indent (current-indentation))
  157.       (previous-line 1) ))
  158.   (back-to-indentation) )
  159.  
  160. (defun hier-next-element (ignore)
  161.   "Goto next hierarchy element at this level or higher."
  162.   (interactive "p")
  163.   (back-to-indentation)
  164.   (let ((indent (current-indentation)))
  165.     (next-line 1)
  166.     (while (< indent (current-indentation))
  167.       (next-line 1) ))
  168.   (back-to-indentation) )
  169.  
  170. (defun hier-upto-parent (arg)
  171.   "Goto the parent hierarchy element."
  172.   (interactive "p")
  173.   (let ((indent (current-indentation)))
  174.     (if (> indent 0)
  175.     (while (<= indent (current-indentation))
  176.       (forward-line -1) )))
  177.   (back-to-indentation) )
  178.  
  179.  
  180. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  181. ;; Find Class Members
  182.  
  183. (defun hier-regexp-list (&optional re-list)
  184.   (end-of-line)
  185.   (let ((eol (point)))
  186.     (back-to-indentation)
  187.     (forward-char 2)
  188.     (let ((re (concat "\C-a" 
  189.               (buffer-substring (point) (progn (while (looking-at "\\sw\\|\\s_")
  190.                              (forward-char 1))
  191.                                (point) ))
  192.               "::")))
  193.       (setq re-list (cons re re-list))
  194.       (forward-word 1)
  195.       (while (<= (point) eol)
  196.     (forward-word -1)
  197.     (let ((start (point))
  198.           (end   (progn (while (looking-at "\\sw\\|\\s_")
  199.                   (forward-char 1))
  200.                 (point) )) )
  201.       (save-excursion
  202.         (hier-find (buffer-substring start end))
  203.         (setq re-list (hier-regexp-list re-list)) ))
  204.     (forward-word 1) )
  205.       re-list)))
  206.  
  207.  
  208. (defvar hier-members-column 30
  209.   "Column to line up member names in *Members List* buffer.")
  210.  
  211. (defun hier-members-apropos (name re-list &optional data-members-only-p)
  212.   "Display list of all tags in tag table that regexp matches."
  213.   (save-excursion
  214.     (with-output-to-temp-buffer "*Members List*"
  215.       (if data-members-only-p
  216.       (princ "== Data Members of Class ")
  217.     (princ "== All Members of Class "))
  218.       (prin1 name)
  219.       (princ " ==")
  220.       (terpri)
  221.       (visit-tags-table-buffer)
  222.       (while re-list
  223.     (goto-char 1)
  224.     (while (re-search-forward (car re-list) nil t)
  225.       (skip-chars-backward "^\C-a")
  226.       (princ (buffer-substring (point)
  227.                    (progn (end-of-line)
  228.                       (point))))
  229.       (terpri)
  230.       (forward-line 1) )
  231.     (setq re-list (cdr re-list)) ))
  232.     (set-buffer "*Members List*")
  233.     ;; Remove Non-Data Members?
  234.     (if data-members-only-p
  235.     ;; remove lines not ending in "_" or "=" (title line)
  236.     (progn (goto-char (point-max))
  237.            (while (not (bobp))
  238.          (forward-char -2)
  239.          (if (not (looking-at "[_=]"))
  240.              (progn (forward-char 2)
  241.                 (delete-region (point) (progn (forward-line -1) (point))))
  242.            (forward-line -1)))))
  243.     ;; Sort Buffer
  244.     (goto-line 2)
  245.     (sort-regexp-fields nil "^.*$" "::[^:\n]*$" (point) (point-max))
  246.     ;; Remove Duplicate Entries
  247.     (goto-line 2)
  248.     (while (not (save-excursion (forward-line 1) (eobp)))
  249.       (if (string-equal (buffer-substring (point) (progn (forward-line 1) (point)))
  250.             (buffer-substring (point) (progn (forward-line 1) (point))))
  251.       (delete-region (point) (progn (forward-line -1) (point))) )
  252.       (forward-line -1) )
  253.     ;; Line Up Colons
  254.     (goto-char (point-min))
  255.     (while (search-forward "::" nil t)
  256.       (let ((indent (- hier-members-column (current-column))))
  257.     (if (> indent 0)
  258.         (progn (beginning-of-line)
  259.            (indent-to-column indent) )))
  260.       (forward-line 1) )
  261.     ))
  262.  
  263.  
  264. (defun hier-show-members (&optional data-members-only-p)
  265.   "Show the members, both direct and inherited, of this hierarchy element."
  266.   (interactive)
  267.   (save-excursion
  268.     (back-to-indentation)
  269.     (forward-char 2)
  270.     (let ((name (buffer-substring (point) (progn (while (looking-at "\\sw\\|\\s_")
  271.                            (forward-char 1))
  272.                          (point) ))) )
  273.       (hier-members-apropos name (hier-regexp-list) data-members-only-p) )))
  274.  
  275.  
  276. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  277. ;; Auxiliary Functions
  278.  
  279. (defun hier-base-list ()
  280.   "Returns a list of the names of all the direct base classes on the current line."
  281.   (save-excursion
  282.     (end-of-line)
  283.     (let ((base-list nil)
  284.       (eol (point)))
  285.       (back-to-indentation)
  286.       (forward-char 2)
  287.       (while (looking-at "\\sw\\|\\s_")
  288.     (forward-char 1))
  289.       (forward-word 1)
  290.       (while (<= (point) eol)
  291.     (forward-word -1)
  292.     (setq base-list (cons (buffer-substring (point)
  293.                         (progn (while (looking-at "\\sw\\|\\s_")
  294.                              (forward-char 1))
  295.                                (point) ))
  296.                   base-list))
  297.     (forward-word 1) )
  298.       base-list) ) )
  299.  
  300.  
  301. (defun hier-derived-list ()
  302.   "Returns a list of the names of all the directly derived classes
  303.    from the one on the current line."
  304.   (save-excursion
  305.     (let ((derived-list nil)
  306.       (indent (current-indentation)))
  307.       (next-line 1)
  308.       (back-to-indentation)
  309.       (while (< indent (current-indentation))
  310.     (forward-char 2)
  311.     (setq derived-list (cons (buffer-substring (point)
  312.                            (progn (while (looking-at "\\sw\\|\\s_")
  313.                                 (forward-char 1))
  314.                               (point) ))
  315.                  derived-list))
  316.     (hier-next-element 1) )
  317.       derived-list) ) )
  318.  
  319.  
  320. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  321. ;; External Functions
  322.  
  323. (defvar hier-file-name nil
  324.   "The filename in which to find the class hierarchy generated by hier++.")
  325.  
  326. (defun prompt-for-hier-file-name ()
  327.   "Get hier-file-name from user."
  328.   (setq hier-file-name
  329.     (read-file-name "File containing class hierarchy [typically CLASS.hier]: ")))
  330.  
  331. (defun class-hierarchy (class-name)
  332.   "Display the hierarchy for the given class.  M-g for next occurrence."
  333.   (interactive (list (prompt-for-tag "Display hierarchy for class: ")))
  334.   (if (not hier-file-name)
  335.       (prompt-for-hier-file-name))
  336.   (find-file-other-window hier-file-name)
  337.   (hier-find class-name))
  338.  
  339. (defun class-members (class-name)
  340.   "Display all members for the given class."
  341.   (interactive (list (prompt-for-tag "Display all members for class: ")))
  342.   (save-excursion
  343.     (set-buffer (find-file-noselect hier-file-name))
  344.     (hier-find class-name)
  345.     (hier-show-members) ))
  346.  
  347. (defun class-data-members (class-name)
  348.   "Display the data members for the given class."
  349.   (interactive (list (prompt-for-tag "Display data members for class: ")))
  350.   (save-excursion
  351.     (set-buffer (find-file-noselect hier-file-name))
  352.     (hier-find class-name)
  353.     (hier-show-members t) ))
  354.